{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit DesignerWizard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, PngImageList, StdCtrls, ExtCtrls, ComCtrls, UIObjects,
  BaseControls, Fills;

type
  TfrmObjectWizard = class(TForm)
    pbHeader: TPaintBox;
    lbCaption: TLabel;
    lbAction: TLabel;
    pnFooter: TPanel;
    btBack: TButton;
    btNext: TButton;
    btFinish: TButton;
    btCancel: TButton;
    nbPages: TNotebook;
    pnIdentity: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label1: TLabel;
    Label4: TLabel;
    Bevel2: TBevel;
    Bevel4: TBevel;
    edDescription: TEdit;
    edName: TEdit;
    edComment: TEdit;
    ecAncestor: TComboBox;
    cbAncestor: TCheckBox;
    pnDescendant: TPanel;
    Bevel1: TBevel;
    Bevel3: TBevel;
    lvClasses: TListView;
    pnStyle: TPanel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    lvStyles: TListView;
    rbBaseDesc: TRadioButton;
    rbCustomDesc: TRadioButton;
    procedure lvStylesAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure lvStylesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure FormDestroy(Sender: TObject);
    procedure lvClassesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure pbHeaderPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btFinishClick(Sender: TObject);
    procedure GUIChange(Sender: TObject);
    procedure edNameExit(Sender: TObject);
    procedure btBackClick(Sender: TObject);
    procedure btNextClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FHeaderImages: TPngImageList;
    FContext: String;
    FTotalPages: Integer;
    FCurrentPage: Integer;
    FAncestor: TAHMUIObject;
    FObjects: TAHMUIObjectList;
    FNewObject: TAHMUIObject;
    FBaseList: Boolean;
    FUpdating: Boolean;
    FControlCache: TAHMControlClass;
    FFillCache: TAHMFillClass;
    FStyleCache: TStringList;
    function GetAncestor: TAHMUIObject;
    function GetDescendant: TAHMUIObjectClass;
    function GetStyle: TAHMUIDisplayObject;
    procedure ConfigureForm;
    procedure BuildPages;
    procedure BuildStyles;
    procedure UpdatePage;
    procedure UpdateGUIState;
    procedure LoadImages;
  public
    { Public declarations }
    property Ancestor: TAHMUIObject read FAncestor write FAncestor;
    property ObjectList: TAHMUIObjectList read FObjects write FObjects;
    property BaseList: Boolean read FBaseList write FBaseList;
    property NewObject: TAHMUIObject read FNewObject;
    class function ShowWizard(Ancestor: TAHMUIObject; List: TAHMUIObjectList; Base: Boolean): TAHMUIObject;
  end;


implementation

{$R *.dfm}

uses ApplicationManager, Designer, DesignerPropsInspector, UIControls, AHMTypes;

var
  FormInstance: TfrmObjectWizard;

//-----------------------------------------------------------------------------
//----------------------------- Class Functions -------------------------------
//-----------------------------------------------------------------------------

class function TfrmObjectWizard.ShowWizard(Ancestor: TAHMUIObject; List: TAHMUIObjectList; Base: Boolean): TAHMUIObject;
begin
  // Set default result - failed
  Result := nil;

  // Ensure we have a valid object list passed
  if not Assigned(List) then Exit;

  // Create a singleton form instance
  if not Assigned(FormInstance) then
  begin
    FormInstance := TfrmObjectWizard.Create(Application.MainForm);
    FormInstance.PopupParent := Application.MainForm;
  end;

  FormInstance.Ancestor := Ancestor;
  FormInstance.ObjectList := List;
  FormInstance.BaseList := Base;

  if FormInstance.ShowModal = mrOK then Result := FormInstance.NewObject;
end;

//-----------------------------------------------------------------------------
//---------------------------- Property Acessors ------------------------------
//-----------------------------------------------------------------------------

function TfrmObjectWizard.GetAncestor: TAHMUIObject;
begin
  if (cbAncestor.State <> cbUnChecked) and (ecAncestor.ItemIndex > 0) then
    Result := FObjects.GetObject(ecAncestor.Text)
  else
    Result := nil;
end;

function TfrmObjectWizard.GetDescendant: TAHMUIObjectClass;
begin
  if Assigned(lvClasses.Selected) then
    Result := TAHMUIObjectClass(lvClasses.Selected.Data)
  else
    Result := nil;
end;

function TfrmObjectWizard.GetStyle: TAHMUIDisplayObject;
begin
  if Assigned(lvStyles.Selected) then
    Result := TAHMUIDisplayObject(lvStyles.Selected.Data)
  else
    Result := nil;
end;

//-----------------------------------------------------------------------------
//------------------------------- Form Events ---------------------------------
//-----------------------------------------------------------------------------

procedure TfrmObjectWizard.FormCreate(Sender: TObject);
begin
  // Create and populate PNG image list
  FHeaderImages := TPngImageList.Create(Self);
  LoadImages;

  // Create a cahe for previous selections
  FStyleCache := TStringList.Create;
end;

procedure TfrmObjectWizard.FormDestroy(Sender: TObject);
begin
  FStyleCache.Free;
end;

procedure TfrmObjectWizard.FormShow(Sender: TObject);
begin
  ConfigureForm;
  BuildPages;
  UpdatePage;
end;

//-----------------------------------------------------------------------------
//------------------------------ Button Events --------------------------------
//-----------------------------------------------------------------------------

procedure TfrmObjectWizard.btBackClick(Sender: TObject);
begin
  // Back to previous page
  Dec(FCurrentPage);
  UpdatePage;
end;

procedure TfrmObjectWizard.btNextClick(Sender: TObject);
begin
  // Move to next page
  Inc(FCurrentPage);
  UpdatePage;
end;

procedure TfrmObjectWizard.btFinishClick(Sender: TObject);
var
  TargetList: TAHMUIObjectList;
begin
  // Determine whether we should create object in base or custom list
  if rbBaseDesc.Checked and Assigned(FObjects.BaseList) then
    TargetList := FObjects.BaseList
  else
    TargetList := FObjects;

  // Create object with specified properties/class
  if GetAncestor <> nil then
  begin
    FNewObject := TargetList.Inherit(ecAncestor.Text, edName.Text);
    if cbAncestor.State = cbGrayed then FNewObject.Ancestor := nil;
  end
  else if GetDescendant <> nil then
    FNewObject := TargetList.Inherit('', edName.Text, GetDescendant)
  else
    FNewObject := TargetList.Inherit('', edName.Text);

  // Assign styles for control if defined
  if (FNewObject is TAHMControl) and (GetStyle <> nil) then
    TAHMControl(FNewObject).Style := GetStyle;

  FNewObject.Comment := edComment.Text;
  FNewObject.Description := edDescription.Text;
  FNewObject.Modified := True;
  FNewObject.SeedObject;
end;

//-----------------------------------------------------------------------------
//----------------------------- Control Events --------------------------------
//-----------------------------------------------------------------------------

procedure TfrmObjectWizard.pbHeaderPaint(Sender: TObject);
begin
  with pbHeader do
  begin
    // Draw background
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(GetClientRect);
    // Draw appropriate header image
    FHeaderImages.Draw(Canvas, ClientWidth - FHeaderImages.Width, 0, 0);
  end;
end;

procedure TfrmObjectWizard.GUIChange(Sender: TObject);
begin
  UpdateGUIState;
end;

procedure TfrmObjectWizard.edNameExit(Sender: TObject);
begin
  // Auto suggest object description if missing
  if (edDescription.Text = '') then
    edDescription.Text := 'New ' + FObjects.ClassName;
end;

procedure TfrmObjectWizard.lvClassesChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  // Ignore this event when exiting
  if Application.Terminated then Exit;

  if (not FUpdating) and (GetDescendant <> nil) then
  begin
    // Cache selected control or fill type
    if GetDescendant.InheritsFrom(TAHMControl) then
      FControlCache := TAHMControlClass(GetDescendant)
    else if GetDescendant.InheritsFrom(TAHMAbstractFill) then
      FFillCache := TAHMFillClass(GetDescendant);

    // Populate list of available styles if a control type has been selected
    if FObjects.ChildClass = TAHMControl then
      BuildStyles;
  end;
end;

procedure TfrmObjectWizard.lvStylesAdvancedCustomDrawItem(
  Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
  UIObject: TAHMUIObject;
begin
  UIObject := TAHMUIObject(Item.Data);

  // Render base items in an alternate font to match treeview on main form
  if not (cdsFocused in State) then
    if UIObject.IsBaseObject then
      Sender.Canvas.Font.Color := clActiveCaption;

  // Render modified items in italics to match treeview on main form
  if UIObject.Modified then
    Sender.Canvas.Font.Style := Sender.Canvas.Font.Style + [fsItalic];
end;

procedure TfrmObjectWizard.lvStylesChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  i: Integer;
begin
  // Ignore this event when exiting
  if Application.Terminated then Exit;

  if (not FUpdating) and (GetDescendant <> nil) and (GetStyle <> nil) then
  begin
    // Cache selected style for current control type
    i := FStyleCache.IndexOf(GetDescendant.ClassName);
    if i < 0 then FStyleCache.AddObject(GetDescendant.ClassName, GetStyle)
             else FStyleCache.Objects[i] := GetStyle;
  end;
end;

//-----------------------------------------------------------------------------
//-------------------------- User Interface Update ----------------------------
//-----------------------------------------------------------------------------

procedure TfrmObjectWizard.ConfigureForm;
var
  i: Integer;
  sCaption, sDesc: String;
begin
  // Populate list of potential ancestors
  ecAncestor.Items.BeginUpdate;
  try
    ecAncestor.Items.Clear;
    ecAncestor.Items.Add(EMPTY_UIOBJECT_NAME);
    for i := 0 to Pred(FObjects.TotalCount) do
      ecAncestor.Items.Add(FObjects[i].Name);
  finally
    ecAncestor.Items.EndUpdate;
  end;

  // Populate default ancestor if any
  with ecAncestor do
    if Assigned(FAncestor) then ItemIndex := Items.IndexOf(FAncestor.Name)
                           else ItemIndex := 0;
  cbAncestor.Checked := Assigned(FAncestor);
  ecAncestor.Enabled := Assigned(FAncestor);

  // Customise display for selected object type
  sCaption := FObjects.ClassName;
  if sCaption = '' then sCaption := 'Object';
  FContext := Lowercase(sCaption);

  Caption := 'New ' + FContext + ' wizard';
  lbCaption.Caption := 'Create a new ' + FContext;

  // Populate default base/custom destination
  if FBaseList then rbBaseDesc.Checked := True
               else rbCustomDesc.Checked := True;
  sDesc := ApplicationManagerInstance.ThemeManager.ThemeGroup;
  if sDesc = '' then sDesc := 'custom';
  rbBaseDesc.Caption := 'Create ' + FContext + ' in base descriptor';
  rbCustomDesc.Caption := 'Create ' + FContext + ' in ' + sDesc + ' descriptor';

  // Provide default name, description and comment
  edName.Text := sCaption + IntToStr(FObjects.TotalCount);
  edDescription.Text := 'New ' + sCaption;
  edComment.Text := '';

  // Start focus in the name edit
  nbPages.PageIndex := 0;
  edName.SetFocus;
end;

procedure TfrmObjectWizard.BuildPages;
  procedure AddItem(sCaption: String; iImageIndex: Integer; Descendant: TAHMUIObjectClass);
  begin
    with lvClasses.Items.Add do
    begin
      Caption := sCaption;
      ImageIndex := iImageIndex;
      Data := Pointer(Descendant);

      // Highlight previously cached control or fill type
      if Descendant.InheritsFrom(TAHMControl) then
        Selected := (Descendant = FControlCache)
      else if Descendant.InheritsFrom(TAHMAbstractFill) then
        Selected := (Descendant = FFillCache);
    end;
  end;
  procedure AddObject(sCaption: String; ObjectType: TAHMUIObjectType; Descendant: TAHMUIObjectClass);
  begin
    AddItem(sCaption, Ord(ObjectType) + STATE_IMG_ACTIONS, Descendant);
  end;
  procedure AddControl(sCaption: String; ControlType: TAHMControlType; Descendant: TAHMUIObjectClass);
  begin
    AddItem(sCaption, Ord(ControlType) + STATE_IMG_OBJECTS, Descendant);
  end;
begin
  // Suppress listview events whilst populating
  FUpdating := True;
  try
    // Clear any old listview items and reset start page
    lvClasses.Items.Clear;
    FCurrentPage := 0;

    // Add an extra page if creating a new control
    if FObjects.ChildClass = TAHMControl then
    begin
      // Pagecount includes extra pages for control class and style
      FTotalPages := 2;

      // Populate list of potential classes
      AddControl('Caption Control',      ctCaption,     TAHMCaptionControl);
      AddControl('Image Control',        ctImage,       TAHMImageControl);
      AddControl('Shape Control',        ctShape,       TAHMShapeControl);
      AddControl('Bar Control',          ctBar,         TAHMBarControl);
      AddControl('Gauge Control',        ctGauge,       TAHMGaugeControl);
      AddControl('Dial Control',         ctDial,        TAHMDialControl);
      AddControl('Media Control',        ctMediaWindow, TAHMMediaControl);
      AddControl('Plugin Control',       ctPlugin,      TAHMPluginControl);
      AddControl('Button Control',       ctButton,      TAHMButtonControl);
      AddControl('Combo Button Control', ctComboButton, TAHMComboButtonControl);
      AddControl('Radio Button Control', ctRadioButton, TAHMRadioButtonControl);
      AddControl('Check Button Control', ctCheckButton, TAHMCheckButtonControl);
      AddControl('Text Edit Control',    ctTextEdit,    TAHMTextEditControl);
      AddControl('Grid Control',         ctGrid,        TAHMGridControl);
      AddControl('Media Grid Contol',    ctGrid,        TAHMMediaGridControl);
      AddControl('Clone Control',        ctClone,       TAHMCloneControl);
    end
    else if FObjects.ChildClass = TAHMAbstractFill then
    begin
      // Pagecount includes an extra page for fill class
      FTotalPages := 1;

      // Populate list of potential classes
      AddObject('Solid Fill',    otFills, TAHMFill);
      AddObject('Gradient Fill', otFills, TAHMGradedFill);
      AddObject('Linear Fill',   otFills, TAHMLinearFill);
    end
    else
    begin
      // Just show a single page
      FTotalPages := 0;
    end;
  finally
    FUpdating := False;
  end;
end;

procedure TfrmObjectWizard.BuildStyles;
  procedure AddStyle(Style, CachedStyle: TAHMUIDisplayObject);
  begin
    with lvStyles.Items.Add do
    begin
      Caption := Style.Name;
      SubItems.Add(Style.DesignerInfo);
      ImageIndex := Style.ImageIndex + STATE_IMG_ACTIONS;
      Data := Pointer(Style);
      Selected := (Style = CachedStyle);
    end;
  end;
var
  i: Integer;
  ControlClass: TAHMControlClass;
  Styles: TAHMUIObjectList;
  CachedStyle: TAHMUIDisplayObject;
begin
  // Suppress listview events whilst populating
  FUpdating := True;
  lvStyles.Items.BeginUpdate;
  try
    lvStyles.Items.Clear;

    // Add permitted styles for selected control type to listview
    if GetDescendant <> nil then
    begin
      ControlClass := TAHMControlClass(GetDescendant);
      Styles := ControlClass.GetStyleList;

      // Lookup cached style for current control type
      i := FStyleCache.IndexOf(ControlClass.ClassName);
      if i < 0 then CachedStyle := nil
               else CachedStyle := TAHMUIDisplayObject(FStyleCache.Objects[i]);

      if Assigned(Styles) then
        for i := 0 to Pred(Styles.TotalCount) do
          AddStyle(TAHMUIDisplayObject(Styles.Objects[i]), CachedStyle);
    end;
  finally
    lvStyles.Items.EndUpdate;
    FUpdating := False;
  end;
end;

procedure TfrmObjectWizard.UpdatePage;
begin
  // Configure panel for appropriate page
  nbPages.PageIndex := FCurrentPage;
  case FCurrentPage of
    0: pnIdentity.Align := alClient;
    1: pnDescendant.Align := alClient;
    2: pnStyle.Align := alClient;
  end;

  // Configure page header caption
  case FCurrentPage of
    0: lbAction.Caption := 'Enter properties for the new ' + FContext + ' below';
    1: lbAction.Caption := 'Choose a type of ' + FContext + ' below';
    2: lbAction.Caption := 'Choose a style for the new ' + FContext + ' below';
  end;

  // Update enabled button state
  UpdateGUIState;
end;

procedure TfrmObjectWizard.UpdateGUIState;
var
  Valid: Boolean;
  Ancestor: TAHMUIObject;
  Descendant: TAHMUIObjectClass;
begin
  // Descendant cannot be chosen if deriving from ancestor
  Ancestor := GetAncestor;
  if Assigned(Ancestor) then
  begin
    lvClasses.Enabled := False;
    lvClasses.Selected := lvClasses.FindData(0, Ancestor, True, False);
  end
  else
    lvClasses.Enabled := True;
  ecAncestor.Enabled := cbAncestor.State <> cbUnchecked;

  // Configure options for creating in base or custom descriptor
  if FObjects.BaseList = nil then
  begin
    // If only base descriptor loaded then must create object there
    rbBaseDesc.Checked := True;
    rbBaseDesc.Enabled := False;
    rbCustomDesc.Enabled := False;
  end
  else if (cbAncestor.State = cbChecked) and (GetAncestor <> nil) and
          not GetAncestor.IsBaseObject then
  begin
    // If ancestor is in custom descriptor, descendant must be too
    rbBaseDesc.Enabled := False;
    rbCustomDesc.Checked := True;
    rbCustomDesc.Enabled := False;
  end
  else
  begin
    // Allow creation in either base or custom descriptor
    rbBaseDesc.Enabled := True;
    rbCustomDesc.Enabled := True;
  end;

  // Style cannot be chosen if creating a clone control
  Descendant := GetDescendant;
  if Descendant <> nil then
    if Descendant = TAHMCloneControl then
    begin
      lvStyles.Enabled := False;
      lvStyles.Selected := lvStyles.FindData(0, Descendant, True, False);
    end
    else
      lvStyles.Enabled := True;

  // Configure ancestor caption according to checked state
  case cbAncestor.State of
    cbUnchecked: cbAncestor.Caption := 'This ' + FContext + ' will not ' +
                                       'inherit or copy any properties';
    cbGrayed: cbAncestor.Caption :=    'This ' + FContext + ' will copy ' +
                                       'its properties from another ' +
                                       FContext + ' object:';
    cbChecked: cbAncestor.Caption :=   'This ' + FContext + ' will inherit ' +
                                       'its properties from another ' +
                                       FContext + ' object:';
  end;

  // Configure next/back buttons according to page no.
  btNext.Enabled := FCurrentPage < FTotalPages;
  btBack.Enabled := FCurrentPage > 0;

  // Enable finish button if we have valid object details
  Valid := FObjects.ValidateObjectName(edName.Text) <> '';

  // Validate class selection if we have multiple pages
  if FTotalPages > 0 then
    Valid := Valid and ((Ancestor <> nil) or (lvClasses.Selected <> nil));

  btFinish.Enabled := Valid;

  // Configure sensible default button
  btFinish.Default := btFinish.Enabled;
  btNext.Default := not (btFinish.Default) and btNext.Enabled;
end;

procedure TfrmObjectWizard.LoadImages;
begin
  with FHeaderImages do
  begin
    Clear;
    Width := 150; Height := 57;

    AddResourcePng('HD_IMG_GENERIC'); //0
  end;

  // Use image lists from main designer form treeview
  with Application.MainForm as TAHMDesignerForm do
    Self.lvClasses.LargeImages := LargeTreeImages;
end;


end.
